PC go! 2008 April

home *** CD-ROM | disk | FTP | other *** search

/ PC go! 2008 April / PCgo 2008-04 (DVD).iso / interface / contents / demoversionen_3846 / 13664 / files / Data1.cab / matrix.frm (.txt) < prev next >

Wrap

Visual Basic Form | 2001-10-16 | 27.9 KB | 897 lines

VERSION 5.00 Begin VB.Form MatrixForm Caption = "Matrix Object Sample" ClientHeight = 7065 ClientLeft = 2370 ClientTop = 735 ClientWidth = 7350 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 7065 ScaleWidth = 7350 Begin VB.CommandButton btExit Caption = "Exit" Height = 492 Left = 120 TabIndex = 60 Top = 6480 Width = 7092 End Begin VB.Frame Frame6 Appearance = 0 'Flat BackColor = &H8000000A& Caption = "Matrix Transformations :" ForeColor = &H80000008& Height = 4212 Left = 3360 TabIndex = 30 Top = 2160 Width = 3852 Begin VB.CommandButton btScaleAndRotate Caption = "TranslateScaleAndRotate" Height = 372 Left = 120 TabIndex = 58 ToolTipText = "Use Rotate, Scale, Angle, Vertex " Top = 3600 Width = 3612 End Begin VB.CommandButton Translate Caption = "Translate" Height = 372 Index = 5 Left = 1320 TabIndex = 57 ToolTipText = "Use Vertex, Bool flag" Top = 3000 Width = 1092 End Begin VB.CommandButton Scale Caption = "Scale" Height = 372 Index = 4 Left = 2520 TabIndex = 56 ToolTipText = "Use Scale, Vertex, Bool flag" Top = 3000 Width = 1212 End Begin VB.CommandButton Rotate Caption = "Rotate" Height = 372 Index = 3 Left = 120 TabIndex = 55 ToolTipText = "Use Rotate, Angle, Vertex, Bool Flag" Top = 3000 Width = 1092 End Begin VB.TextBox valFlag Height = 288 Left = 1680 TabIndex = 49 Top = 2280 Width = 612 End Begin VB.TextBox valAngle Height = 288 Left = 1680 TabIndex = 48 Top = 1920 Width = 612 End Begin VB.TextBox valRotZ Height = 288 Left = 3120 TabIndex = 43 Top = 1440 Width = 612 End Begin VB.TextBox valRotY Height = 288 Left = 2400 TabIndex = 42 Top = 1440 Width = 612 End Begin VB.TextBox valRotX Height = 288 Left = 1680 TabIndex = 41 Top = 1440 Width = 612 End Begin VB.TextBox valScaleZ Height = 288 Left = 3120 TabIndex = 40 Top = 1080 Width = 612 End Begin VB.TextBox valScaleY Height = 288 Left = 2400 TabIndex = 39 Top = 1080 Width = 612 End Begin VB.TextBox valScaleX Height = 288 Left = 1680 TabIndex = 38 Top = 1080 Width = 612 End Begin VB.TextBox valVertexZ Height = 288 Left = 3120 TabIndex = 33 Top = 720 Width = 612 End Begin VB.TextBox valVertexY Height = 288 Left = 2400 TabIndex = 32 Top = 720 Width = 612 End Begin VB.TextBox valVertexX Height = 288 Left = 1680 TabIndex = 31 Top = 720 Width = 612 End Begin VB.Line Line6 BorderColor = &H80000006& X1 = 0 X2 = 3960 Y1 = 2760 Y2 = 2760 End Begin VB.Label Label6 Caption = "Parameters :" Height = 252 Left = 120 TabIndex = 51 Top = 240 Width = 1332 End Begin VB.Label Label5 Caption = "Bool flag :" Height = 252 Left = 120 TabIndex = 50 Top = 2280 Width = 1332 End Begin VB.Label Label4 Caption = "Angle :" Height = 252 Left = 120 TabIndex = 47 Top = 1920 Width = 1332 End Begin VB.Line Line4 BorderColor = &H80000006& X1 = 1560 X2 = 3840 Y1 = 1800 Y2 = 1800 End Begin VB.Label Label3 Caption = "Rotate :" Height = 252 Left = 120 TabIndex = 46 Top = 1440 Width = 1332 End Begin VB.Label Label2 Caption = "Scale :" Height = 252 Index = 1 Left = 120 TabIndex = 45 Top = 1080 Width = 1332 End Begin VB.Label Label2 Caption = "Vertex :" Height = 252 Index = 0 Left = 120 TabIndex = 44 Top = 720 Width = 1332 End Begin VB.Line Line3 BorderColor = &H80000006& X1 = 1560 X2 = 1560 Y1 = 240 Y2 = 2760 End Begin VB.Line Line2 BorderColor = &H80000006& X1 = 0 X2 = 3840 Y1 = 600 Y2 = 600 End Begin VB.Label Label1 Alignment = 2 'Center Caption = "Z" Height = 252 Index = 2 Left = 3120 TabIndex = 36 Top = 240 Width = 612 End Begin VB.Label Label1 Alignment = 2 'Center Caption = "Y" Height = 252 Index = 1 Left = 2400 TabIndex = 35 Top = 240 Width = 612 End Begin VB.Label Label1 Alignment = 2 'Center Caption = "X" Height = 252 Index = 0 Left = 1680 TabIndex = 34 Top = 240 Width = 612 End End Begin VB.Frame Frame5 Appearance = 0 'Flat BackColor = &H8000000A& Caption = "Matrix's set" ForeColor = &H80000008& Height = 4212 Left = 120 TabIndex = 11 Top = 2160 Width = 3012 Begin VB.CommandButton Transpose Caption = "Transpose" Height = 372 Index = 0 Left = 120 TabIndex = 54 Top = 3720 Width = 2772 End Begin VB.CommandButton Invert Caption = "Invert" Height = 372 Index = 0 Left = 1560 TabIndex = 53 Top = 3240 Width = 1332 End Begin VB.CommandButton Identity Caption = "Identity" Height = 372 Index = 1 Left = 120 TabIndex = 52 Top = 3240 Width = 1332 End Begin VB.ComboBox cbMatrix Height = 288 Left = 120 TabIndex = 37 Top = 2280 Width = 2772 End Begin VB.CommandButton btSet Caption = "Set" Height = 372 Left = 120 TabIndex = 29 Top = 2760 Width = 1332 End Begin VB.CommandButton btGet Caption = "Get" Height = 372 Left = 1560 TabIndex = 28 Top = 2760 Width = 1332 End Begin VB.TextBox matrix_33 Height = 288 Left = 2280 TabIndex = 27 Top = 1800 Width = 612 End Begin VB.TextBox matrix_32 Height = 288 Left = 1560 TabIndex = 26 Top = 1800 Width = 612 End Begin VB.TextBox matrix_31 Height = 288 Left = 840 TabIndex = 25 Top = 1800 Width = 612 End Begin VB.TextBox matrix_30 Height = 288 Left = 120 TabIndex = 24 Top = 1800 Width = 612 End Begin VB.TextBox matrix_23 Height = 288 Left = 2280 TabIndex = 23 Top = 1440 Width = 612 End Begin VB.TextBox matrix_22 Height = 288 Left = 1560 TabIndex = 22 Top = 1440 Width = 612 End Begin VB.TextBox matrix_21 Height = 288 Left = 840 TabIndex = 21 Top = 1440 Width = 612 End Begin VB.TextBox matrix_20 Height = 288 Left = 120 TabIndex = 20 Top = 1440 Width = 612 End Begin VB.TextBox matrix_13 Height = 288 Left = 2280 TabIndex = 19 Top = 1080 Width = 612 End Begin VB.TextBox matrix_12 Height = 288 Left = 1560 TabIndex = 18 Top = 1080 Width = 612 End Begin VB.TextBox matrix_11 Height = 288 Left = 840 TabIndex = 17 Top = 1080 Width = 612 End Begin VB.TextBox matrix_10 Height = 288 Left = 120 TabIndex = 16 Top = 1080 Width = 612 End Begin VB.TextBox matrix_03 Height = 288 Left = 2280 TabIndex = 15 Top = 720 Width = 612 End Begin VB.TextBox matrix_02 Height = 288 Left = 1560 TabIndex = 14 Top = 720 Width = 612 End Begin VB.TextBox matrix_01 Height = 288 Left = 840 TabIndex = 13 Top = 720 Width = 612 End Begin VB.TextBox matrix_00 Height = 288 Left = 120 TabIndex = 12 Top = 720 Width = 612 End Begin VB.Line Line8 BorderColor = &H80000006& X1 = 3000 X2 = 0 Y1 = 600 Y2 = 600 End Begin VB.Label Label7 Alignment = 2 'Center Caption = "Contents :" Height = 252 Left = 840 TabIndex = 59 Top = 240 Width = 1332 End Begin VB.Line Line1 BorderColor = &H80000006& X1 = 0 X2 = 3000 Y1 = 2160 Y2 = 2160 End End Begin VB.Frame Frame3 Appearance = 0 'Flat BackColor = &H8000000A& Caption = "Create :" ClipControls = 0 'False ForeColor = &H80000008& Height = 1932 Left = 120 TabIndex = 0 Top = 120 Width = 7092 Begin VB.Frame Frame2 Appearance = 0 'Flat BackColor = &H8000000A& Caption = "Command :" ForeColor = &H80000008& Height = 1332 Left = 3240 TabIndex = 3 Top = 360 Width = 3732 Begin VB.CommandButton btDuplicate Caption = "Duplicate" Enabled = 0 'False Height = 372 Left = 1320 TabIndex = 10 Top = 480 Width = 1092 End Begin VB.CommandButton btDelete Caption = "Delete" Enabled = 0 'False Height = 372 Left = 2520 TabIndex = 9 Top = 480 Width = 1092 End Begin VB.CommandButton btCreate Caption = "Create" Height = 372 Left = 120 TabIndex = 8 Top = 480 Width = 1092 End End Begin VB.Frame Frame1 Appearance = 0 'Flat BackColor = &H8000000A& Caption = "Server mode :" ForeColor = &H80000008& Height = 1332 Left = 1560 TabIndex = 2 Top = 360 Width = 1452 Begin VB.OptionButton optLocal Caption = "Local" Height = 252 Left = 120 TabIndex = 7 Top = 840 Width = 852 End Begin VB.OptionButton optInproc Caption = "In-proc" Height = 252 Left = 120 TabIndex = 6 Top = 360 Value = -1 'True Width = 852 End End Begin VB.Frame Frame4 Appearance = 0 'Flat BackColor = &H8000000A& Caption = "Object :" ClipControls = 0 'False ForeColor = &H80000008& Height = 1332 Left = 120 TabIndex = 1 Top = 360 Width = 1335 Begin VB.OptionButton optVertex Caption = "Vertex" Height = 252 Left = 120 TabIndex = 5 Top = 840 Width = 975 End Begin VB.OptionButton optMatrix Caption = "Matrix" Height = 252 Left = 120 TabIndex = 4 Top = 360 Value = -1 'True Width = 732 End End End Begin VB.Line Line7 X1 = 120 X2 = 3120 Y1 = 2760 Y2 = 2760 End Begin VB.Line Line5 X1 = 3360 X2 = 7200 Y1 = 2520 Y2 = 2520 End Attribute VB_Name = "MatrixForm" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False '******************************************************************' '* *' '* TurboCAD for Windows *' '* Copyright (c) 1993 - 2001 *' '* International Microcomputer Software, Inc. *' '* (IMSI) *' '* All rights reserved. *' '* *' '******************************************************************' Dim bObject As Boolean Dim bMode As Boolean Dim objVertex As Object Dim objarrMatrix(99) As Object Dim indMatrix As Long Dim varMatrix As Variant Dim dblMatrix(3, 3) As Double Private Sub btCreate_Click() Dim strMatrix As String On Error GoTo ErrorHandler If (bObject = True) Then indMatrix = indMatrix + 1 If (bMode = True) Then strMatrix = "In-proc matrix" Set objarrMatrix(indMatrix) = CreateObject("IMSIGX.Matrix.4") Else strMatrix = "Local matrix" Set objarrMatrix(indMatrix) = CreateObject("TurboCad.Matrix.4") End If strMatrix = strMatrix + Str(indMatrix) cbMatrix.AddItem strMatrix cbMatrix.Text = cbMatrix.List(indMatrix) btDuplicate.Enabled = True Else If (bMode = True) Then Set objVertex = CreateObject("IMSIGX.Vertex.4") Else Set objVertex = CreateObject("TurboCad.Vertex.4") End If btCreate.Enabled = False btDuplicate.Enabled = False btDelete.Enabled = True End If Exit Sub ErrorHandler: MsgBox Error(Err.Number) End Sub Private Sub btDelete_Click() On Error GoTo ErrorHandler If (bObject = False) Then objVertex.Delete btDelete.Enabled = False btCreate.Enabled = True Else If (ind < atrix >= 0) Then objarrMatrix(indMatrix).Delete If (indMatrix > cbMatrix.ListCount) Then indMatrix = indMatrix - 1 End If End If End If Exit Sub ErrorHandler: MsgBox Error(Err.Number) End Sub Private Sub btDuplicate_Click() Dim indNewMatrix As Long Dim strMatrix As String On Error GoTo ErrorHandler If (bObject = True) Then indNewMatrix = cbMatrix.ListCount If (indMatrix > 99) Then Error 9 Else Set objarrMatrix(indNewMatrix) = objarrMatrix(indMatrix).Duplicate strMatrix = cbMatrix.Text + Str(indNewMatrix) cbMatrix.AddItem strMatrix cbMatrix.Text = cbMatrix.List(indNewMatrix) End If Else MsgBox "Don't duplicate Vertex !" End If Exit Sub ErrorHandler: MsgBox Error(Err.Number) End Sub Private Sub btExit_Click() On Error Resume Next objVertex.Delete End End Sub Private Sub btGet_Click() Dim i As Integer Dim j As Integer On Error GoTo ErrorHandler If (indMatrix < 0) Then Error 424 For i = 0 To 3 Step 1 For j = 0 To 3 Step 1 dblMatrix(i, j) = 0 Next j Next i varMatrix = dblMatrix objarrMatrix(indMatrix).GetArray varMatrix matrix_00.Text = varMatrix(0, 0) matrix_01.Text = varMatrix(0, 1) matrix_02.Text = varMatrix(0, 2) matrix_03.Text = varMatrix(0, 3) matrix_10.Text = varMatrix(1, 0) matrix_11.Text = varMatrix(1, 1) matrix_12.Text = varMatrix(1, 2) matrix_13.Text = varMatrix(1, 3) matrix_20.Text = varMatrix(2, 0) matrix_21.Text = varMatrix(2, 1) matrix_22.Text = varMatrix(2, 2) matrix_23.Text = varMatrix(2, 3) matrix_30.Text = varMatrix(3, 0) matrix_31.Text = varMatrix(3, 1) matrix_32.Text = varMatrix(3, 2) matrix_33.Text = varMatrix(3, 3) Exit Sub ErrorHandler: MsgBox Error(Err.Number) End Sub Private Sub btScaleAndRotate_Click() Dim X As Double Dim Y As Double Dim Z As Double Dim XScale As Double Dim YScale As Double Dim ZScale As Double Dim Angle As Double Dim varVertex As Variant On Error GoTo ErrorHandler If (indMatrix < 0) Then Error 424 X = Val(valVertexX.Text) Y = Val(valVertexY.Text) Z = Val(valVertexZ.Text) objVertex.X = X objVertex.Y = Y objVertex.Z = Z Set varVertex = objVertex XScale = Val(valScaleX.Text) YScale = Val(valScaleY.Text) ZScale = Val(valScaleZ.Text) X = Val(valRotX.Text) Y = Val(valRotY.Text) Z = Val(valRotZ.Text) Angle = Val(valAngle.Text) objarrMatrix(indMatrix).TranslateScaleAndRotateZ X, Y, Z, XScale, YScale, ZScale, Angle, varVertex Exit Sub ErrorHandler: MsgBox Error(Err.Number) End Sub Private Sub btSet_Click() On Error GoTo ErrorHandler If (indMatrix < 0) Then Error 424 dblMatrix(0, 0) = Val(matrix_00.Text) dblMatrix(0, 1) = Val(matrix_01.Text) dblMatrix(0, 2) = Val(matrix_02.Text) dblMatrix(0, 3) = Val(matrix_03.Text) dblMatrix(1, 0) = Val(matrix_10.Text) dblMatrix(1, 1) = Val(matrix_11.Text) dblMatrix(1, 2) = Val(matrix_12.Text) dblMatrix(1, 3) = Val(matrix_13.Text) dblMatrix(2, 0) = Val(matrix_20.Text) dblMatrix(2, 1) = Val(matrix_21.Text) dblMatrix(2, 2) = Val(matrix_22.Text) dblMatrix(2, 3) = Val(matrix_23.Text) dblMatrix(3, 0) = Val(matrix_30.Text) dblMatrix(3, 1) = Val(matrix_31.Text) dblMatrix(3, 2) = Val(matrix_32.Text) dblMatrix(3, 3) = Val(matrix_33.Text) varMatrix = dblMatrix objarrMatrix(indMatrix).SetArray varMatrix Exit Sub ErrorHandler: MsgBox Error(Err.Number) End Sub Private Sub cbMatrix_Click() indMatrix = cbMatrix.ListIndex End Sub Private Sub Form_Load() bObject = True bMode = True indMatrix = -1 End Sub Private Sub Identity_Click(Index As Integer) On Error GoTo ErrorHandler If (indMatrix < 0) Then Error 424 objarrMatrix(indMatrix).Identity Exit Sub ErrorHandler: MsgBox Error(Err.Number) End Sub Private Sub Invert_Click(Index As Integer) On Error GoTo ErrorHandler If (indMatrix < 0) Then Error 424 objarrMatrix(indMatrix).Invert Exit Sub ErrorHandler: MsgBox Error(Err.Number) End Sub Private Sub optInproc_Click() bMode = True 'In-proc server optLocal.Value = False End Sub Private Sub optLocal_Click() bMode = False 'Local server optInproc.Value = False End Sub Private Sub optMatrix_Click() bObject = True ' Create matrix object optVertex.Value = False btCreate.Enabled = True btDelete.Enabled = False If (indMatrix >= 0) Then btDuplicate.Enabled = True Else btDuplicate.Enabled = False End If End Sub Private Sub optVertex_Click() Dim hVertex As Long bObject = False 'Create vertex object optMatrix.Value = False btDuplicate.Enabled = False On Error GoTo ErrorHandler hVertex = objVertex.GetHandle() VertexExist: btCreate.Enabled = False btDelete.Enabled = True Exit Sub ErrorHandler: If (Err.Number <> 438) Then btDelete.Enabled = False btCreate.Enabled = True Else GoTo VertexExist End If End Sub Private Sub Rotate_Click(Index As Integer) Dim X As Double Dim Y As Double Dim Z As Double Dim Angle As Double Dim varConcat As Variant Dim varVertex As Variant Dim bConcat As Boolean On Error GoTo ErrorHandler If (indMatrix < 0) Then Error 424 X = Val(valVertexX.Text) Y = Val(valVertexY.Text) Z = Val(valVertexZ.Text) objVertex.X = X objVertex.Y = Y objVertex.Z = Z Set varVertex = objVertex X = Val(valRotX.Text) Y = Val(valRotY.Text) Z = Val(valRotZ.Text) Angle = Val(valAngle.Text) bConcat = Val(valFlag) varConcat = bConcat objarrMatrix(indMatrix).Rotate X, Y, Z, Angle, varVertex, varConcat Exit Sub ErrorHandler: MsgBox Error(Err.Number) End Sub Private Sub Scale_Click(Index As Integer) Dim hResult As Long Dim X As Double Dim Y As Double Dim Z As Double Dim varConcat As Variant Dim varVertex As Variant Dim bConcat As Boolean On Error GoTo ErrorHandler If (indMatrix < 0) Then Error 424 X = Val(valVertexX.Text) Y = Val(valVertexY.Text) Z = Val(valVertexZ.Text) objVertex.X = X objVertex.Y = Y objVertex.Z = Z Set varVertex = objVertex X = Val(valScaleX.Text) Y = Val(valScaleY.Text) Z = Val(valScaleZ.Text) bConcat = Val(valFlag) varConcat = bConcat hResult = objarrMatrix(indMatrix).Scale(X, Y, Z, varVertex, varConcat) Exit Sub ErrorHandler: MsgBox Error(Err.Number) End Sub Private Sub Translate_Click(Index As Integer) Dim X As Double Dim Y As Double Dim Z As Double Dim varConcat As Variant Dim varVetrex As Variant Dim bConcat As Boolean On Error GoTo ErrorHandler If (indMatrix < 0) Then Error 424 X = Val(valVertexX.Text) Y = Val(valVertexY.Text) Z = Val(valVertexZ.Text) bConcat = Val(valFlag) varConcat = bConcat objarrMatrix(indMatrix).Translate X, Y, Z, varConcat Exit Sub ErrorHandler: MsgBox Error(Err.Number) End Sub Private Sub Transpose_Click(Index As Integer) On Error GoTo ErrorHandler If (indMatrix < 0) Then Error 424 objarrMatrix(indMatrix).Transpose Exit Sub ErrorHandler: MsgBox Error(Err.Number) End Sub